module Main where

import Data.Binary.Get
import Data.Word
import Control.Monad
import qualified Data.ByteString.Lazy as B
import qualified Data.Text as T
import Data.Double.Conversion.Text
import Data.Bits (shiftR, (.&.))
import Text.Printf (printf)

bxFrames,byFrames,lxFrames,lyFrames,lFrames :: Int
bxFrames = 72
byFrames = 30
lxFrames = 5*16
lyFrames = 6*16
lFrames  = lxFrames*lyFrames

bxSize,bySize,lxSize,lySize :: Double
bxSize = 360 / fromIntegral bxFrames
bySize = 180 / fromIntegral byFrames
lxSize = bxSize / fromIntegral lxFrames
lySize = bySize / fromIntegral lyFrames

fstr,fidx :: FilePath
fstr = "dec-90.bin"
fidx = "dec-90.idx"

getIdx :: FilePath -> IO ([Word32], [Word16])
getIdx fname = runGet idxParser `liftM` B.readFile fname 
  where
    idxParser = do
      offs   <- replicateM bxFrames getWord32be
      nstars <- replicateM (lFrames*bxFrames) getWord16be
      return (offs, nstars)

type Ra   = Double
type Dec  = Double
type Mag  = Double
type Flag = Word8 
type Star = (Ra,Dec,Mag,Flag)

ra_dec :: Dec -> [(Ra,Dec)]
ra_dec delta0 = do
  a0 <- [0..bxFrames-1]
  b  <- [0..lyFrames-1]
  a1 <- [0..lxFrames-1]
  let ra  = bxSize * fromIntegral a0 + lxSize * fromIntegral a1
      dec = delta0 + lySize * fromIntegral b
  return (ra,dec)

starParser :: (Ra,Dec) -> Get Star
starParser (ra0,dec0) = do
  a <- getWord16be
  b <- getWord16be
  c <- getWord16be
  let ra  = ra0 + 1e-6 * fromIntegral a
      dec = dec0 + 1e-6 * fromIntegral b
      m'  = shiftR c 3
      m   = if m' < 500 
            then 1e-1 * fromIntegral m' - 26.0
            else 1e-2 * fromIntegral m' - 8.0
      flag = fromIntegral (c .&. 0x07) :: Word8
  return (ra,dec,m,flag)
      
joinGet :: [Get a] -> B.ByteString -> [a]
joinGet [] _ = []
joinGet (p:ps) s = let (a,s',_) = runGetState p s 0
                   in a : joinGet ps s'

readStars :: FilePath -> FilePath -> Dec -> IO ()
readStars idx cat delta0 = do
  ns <- (map fromIntegral . snd) `liftM` getIdx idx
  stream <- B.readFile cat
  let parsers = map (\(n,p) -> replicateM n (starParser p)) $ 
                zip ns (ra_dec delta0)
      stars = concat $ joinGet parsers stream
  forM_ stars $ \(x,y,m,flag) -> putStrLn $ sepTab [dts x, dts y, dts m, show flag]

sepTab :: [String] -> String
sepTab = tail . concatMap ("\t"++) 

main = mapM_ (\(i,f,d) -> readStars i f (fromIntegral d)) $ do
--  i <- [-90,-84..84] :: [Int]
  i <- [84] :: [Int]
  let s = printf "%+03d" i
      iname = "dec"++s++".idx"
      cname = "dec"++s++".bin"
  return (iname, cname, i)
        
dts :: Double -> String
dts = T.unpack . toExponential 6

